ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Interfaces/PInterfaces/UList.p

Text File | 1990-10-25 | 22.9 KB | 548 lines | [TEXT/MPS ]

{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UList.p }
{ Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }

{ Unit UList defines object types TList, a simple dynamic array whose elements are references to
  TObjects, and TSortedList, which maintains the object references in a sequence defined by
  overriding TSortedList.Compare.

    Peter Gaston's scheme for chunky memory allocation has been used by permission.
    Thanks Peter!.

TList:
    TList is an object which provides a very nice dynamic array of objects.
    It is implemented by appending the dynamic array onto the end of the
    object.  Growing and shrinking the array is done by growing and shrinking
    the handle which holds the object.

TSortedList:
    TSortedList maintains the object references in a sequence defined by
    overriding TSortedList.Compare


Some Specific uses that TList is especially good for.

    LIFO Stack:
        A push/pop operation is provided.

    FIFO Stack: (Queue)
        Use InsertLast for Queue and First for Dequeue.

    Pre-allocation of your list:
        If you know the size that your list will eventually reach, then you can
        pre-set it to the proper size.

    Delete by Index:
        If you keep track of items by index number, then you can avoid
        a linear search when you want to delete it. Remember though, it
        is a dynamic list and any insertion/deletion activity can cause
        the index to point at a different element than you expect.

Caveats:
    A _small_ amount of memory is always wasted with this method.  An active
    list will generally waste one-half of the chunk size, or
    4*2=8 bytes/TList.

}

{$IFC UNDEFINED UsingIncludes}
{$SETC UsingIncludes := FALSE}
{$ENDC}

{$IFC NOT UsingIncludes}
UNIT UList;

    INTERFACE
        {$ENDC}

        {$IFC UNDEFINED __UList__}
        {$SETC __UList__ := FALSE}
        {$ENDC}

        {$IFC NOT __UList__}
        {$SETC __UList__ := TRUE}

        { • Auto-Include the requirements for this unit's interface. }
        {$SETC UListIncludes := UsingIncludes}
        {$SETC UsingIncludes := TRUE}
        {$I+}
        {$IFC UNDEFINED __UObject__} {$I UObject.p} {$ENDC}
        {$SETC UsingIncludes := UListIncludes}

        CONST
            kAllocationIncrement = 6;                    { Initial Allocation increment. Six
                                                         elements of slop shouldn't break anybody
                                                         and provides a _nice_ cushion from the
                                                         memory manager. }
            kIterateForward     = true;
            kIterateBackward    = NOT kIterateForward;

            kEmptyIndex         = 0;                    { Value to use when no valid index is
                                                         available Indexes are always positive }

            { Constants for TSortedList.Compare }
            kItem1LessThanItem2 = - 1;
            kItem1EqualItem2    = 0;
            kItem1GreaterThanItem2 = 1;

            kALessThanB         = kItem1LessThanItem2;    { Left in for compatibility (2.0) }
            kAEqualB            = kItem1EqualItem2;     { Left in for compatibility (2.0) }
            kAGreaterThanB        = kItem1GreaterThanItem2; { Left in for compatibility (2.0) }

            { Constants for TSortedList.Search.
            The criteria is considered to be item 2}
            kItemGreaterThanCriteria = kItem1LessThanItem2;
            kItemEqualCriteria    = kItem1EqualItem2;
            kItemLessThanCriteria = kItem1GreaterThanItem2;

        TYPE

            PtrBasedDoublyLinkedListNodePtr = ^PtrBasedDoublyLinkedListNode;
            PtrBasedDoublyLinkedListNode = RECORD
                previousLink:        PtrBasedDoublyLinkedListNodePtr; { link to previous node }
                nextLink:            PtrBasedDoublyLinkedListNodePtr; { link to next node }
                END;

            TPtrBasedDoublyLinkedList = OBJECT (TObject) { Manages a doubly linked list of nodes.
                                                          The nodes are pointer based since they
                                                          will typically be on the stack }
                fHeadNodePtr:        PtrBasedDoublyLinkedListNodePtr; { HEAD of the linked list }
                fTailNodePtr:        PtrBasedDoublyLinkedListNodePtr; { TAIL of the linked list }
                                {Creation/Destruction Methods}

                PROCEDURE TPtrBasedDoublyLinkedList.IPtrBasedDoublyLinkedList;
                { Initialize a new linked list.}

                PROCEDURE TPtrBasedDoublyLinkedList.AppendNode(thisNode: UNIV
                                                               PtrBasedDoublyLinkedListNodePtr);
                { Add a new node to the list }

                PROCEDURE TPtrBasedDoublyLinkedList.RemoveNode(thisNode: UNIV
                                                               PtrBasedDoublyLinkedListNodePtr);
                { Remove a node from the list }

                PROCEDURE TPtrBasedDoublyLinkedList.EachNodeDo(PROCEDURE
                                                               DoToNode(thisNode: UNIV
                                                                     PtrBasedDoublyLinkedListNodePtr
                                                                        ));
                { Call do to node for each node in the list, passing a pointer to the node as a
                parameter to the called procedure. }

                { Debugging Methods }

                PROCEDURE TPtrBasedDoublyLinkedList.Fields(PROCEDURE
                                                           DoToField(fieldName: Str255;
                                                                     fieldAddr: Ptr;
                                                                     fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                fields. }

                END;

            ArrayIndex            = kEmptyIndex..MaxLongint; { At least always positive ( in this
                                                            universe ) !!! kEmptyIndex..MaxLong
                                                            would be a nice enhancement }
            CompareResult        = integer;                { Negative, zero, and positive results are
                                                         all meaningful even though we have the
                                                         nice constants above. }


            IterationNodePtr    = ^IterationNode;
            IterationNode        = RECORD
                previousLink:        IterationNodePtr;    { link to previous iteration record }
                nextLink:            IterationNodePtr;    { link to next iteration record }
                iterLowBound:        ArrayIndex;            { lower bound of iteration in progress }
                iterIndex:            ArrayIndex;         { current index of this iteration }
                iterHighBound:        ArrayIndex;            { upper bound of iteration in progress }
                iterForward:        Boolean;            { if iteration is forward or backward
                                                         through the list }
                END;

            TDynamicArray        = OBJECT (TPtrBasedDoublyLinkedList) { TDynamicArrays don't really
                                                                      have an IS A relationship
                                                                      with
                                                                      TPtrBasedDoublyLinkedList but
                                                                      have a HAS A relationship
                                                                      with it. We subclass it here,
                                                                      however, because to have a
                                                                      HAS A relationship with it
                                                                      would require *YET ANOTHER*
                                                                      object in the heap and this
                                                                      dynamically sized object
                                                                      stuff is supposed to help
                                                                      reduce that need. }
                fSize:                ArrayIndex;         { number of elements ACTUALLY in the array,
                                                         from 0 to the limit of memory}
                fElementSize:        integer;            { Size in bytes of an element. MUST be a
                                                         power of 2 ie. 1, 2, 4, 8, 16, etc. }
                fElementSizeShift:    integer;            { the power of 2 for the element size. Will
                                                         be used to avoid DIV and MUL }

                fAllocationIncrement: ArrayIndex;        { Number of elements by which to increase of
                                                         decrease the allocated size of the array
                                                         when it needs to grow or shrink. Thus
                                                         reducing memory manager aggravation. }
                fAllocatedSize:     ArrayIndex;         { Number of elements for which storage is
                                                         ALLOCATED }
                fFreeRequested:     Boolean;            { TRUE if the Free method was called but
                                                         couldn't be honored because enumeration
                                                         was in process. Checked at end of
                                                         enumeration and Free is called if true }
                fClassSize:            Size;                { Used with ComputeAddress to create a
                                                        pointer to an element.  This breaks
                                                        encapsulation of GetDynamicArea but, is being
                                                        done here for performance reasons (small) }
                                {Creation/Destruction Methods}

                PROCEDURE TDynamicArray.IDynamicArray(initialSize: ArrayIndex;
                                                      elementSize: integer);
                { Initialize a new array with initialSize elements, Always call it once before
                calling any other method.  Never call it twice.}

                { Array manipulation primitives }

                FUNCTION TDynamicArray.GetSize: ArrayIndex;
                { Returns the ACTUAL number of elements in the array.}

                PROCEDURE TDynamicArray.SetArraySize(theSize: ArrayIndex);
                { Sets the array allocation to handle up to theSize elements }

                FUNCTION TDynamicArray.EachElementDoTil(FUNCTION
                                                        TestElement(elementIndex: ArrayIndex):
                                                        Boolean;
                                                        IterateForward: Boolean): ArrayIndex;
                { The basic array iterator. Call TestIndex once for each element of the array, in order,
                until TestIndex returns TRUE.
                  Return the element that satisfied the test.  If none satisfied the test, return kEmptyIndex.
                }
                PROCEDURE TDynamicArray.Free; OVERRIDE;
                { If enumeration of the array is in process, delete all the array elements,
                mark the fFreeRequested flag for testing at completion of the enumeration and
                return.  Otherwise really free the array.  Gee, wouldn't automatic storage
                management be great! }

                PROCEDURE TDynamicArray.InsertElementsBefore(index: ArrayIndex;
                                                             ElementPtr: UNIV Ptr;
                                                             count: ArrayIndex);
                { Insert Elements before the indicated Element. The index of the new element
                  will be index.   If index = 1 this inserts at the start of the array. If index = fSize + 1
                  this inserts at the end of the array. Signals Failure if unable to change the size of
                  the array.

                  !!! NOTE MULTIPLE ( >1 ) element moves for non-power of 2 element sizes are NOT
                  yet supported! }

                PROCEDURE TDynamicArray.ReplaceElementsAt(index: ArrayIndex;
                                                          ElementPtr: UNIV Ptr;
                                                          count: ArrayIndex);
                { Replaces the Elements at the indicated index.

                  !!! NOTE MULTIPLE ( >1 ) element moves for non-power of 2 element sizes are NOT
                  yet supported! }

                PROCEDURE TDynamicArray.DeleteElementsAt(index: ArrayIndex;
                                                         count: ArrayIndex);
                { Deletes the Element at the indicated index.  Compresses the array

                  !!! NOTE MULTIPLE ( >1 ) element moves for non-power of 2 element sizes are NOT
                  yet supported! }

                PROCEDURE TDynamicArray.GetElementsAt(index: ArrayIndex;
                                                      ElementPtr: UNIV Ptr;
                                                      count: ArrayIndex);
                { copies count elements to the location specified by ptr.

                  !!! NOTE MULTIPLE ( >1 ) element moves for non-power of 2 element sizes are NOT
                  yet supported! }

                FUNCTION TDynamicArray.ComputeAddress(index: ArrayIndex): Ptr;
                { Returns a pointer to of the index-th element in the array.

                PLEASE NOTE: The return value is a direct heap pointer and should be used with
                care as the heap can compact across calls that move memory; thus invalidating
                the pointer. }

                { Misc. functions }

                FUNCTION TDynamicArray.IsEmpty: Boolean;
                { Test if this array is empty or not. }

                PROCEDURE TDynamicArray.Merge(aDynamicArray: TDynamicArray);
                { merges aDynamicArray with itself. leaves aDynamicArray unchanged.

                  !!! NOTE MULTIPLE ( >1 ) element moves for non-power of 2 element sizes are NOT
                  yet supported! }

                { Debugging Methods }

                PROCEDURE TDynamicArray.Fields(PROCEDURE
                                               DoToField(fieldName: Str255;
                                                         fieldAddr: Ptr;
                                                         fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                fields. }

                PROCEDURE TDynamicArray.DynamicFields(PROCEDURE
                                                      DoToField(fieldName: Str255;
                                                                fieldAddr: Ptr;
                                                                fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                dynamic area. }

                END;

            TList                = OBJECT (TDynamicArray) {A dynamic list of TObjects. It IS
                                                          permissible for descendants to add more
                                                          named fields}
                fObjClassID:        ObjClassID;         { if <> kNilClass then the Class ID of the
                                                         elements of the list }
                                {Creation/Destruction Methods}

                PROCEDURE TList.IList;
                { Initialize a new list with no elements, i.e., fSize = 0.    Always
                  call it once before calling any other method.  Never call it
                  twice.}

                PROCEDURE TList.FreeList;
                { Frees each object in the list, then frees the list.}

                { Utility Methods}

                FUNCTION TList.At(index: ArrayIndex): TObject;
                { Return the index'th element of the list. It is typical for the caller to coerce the
                result into a descendant of TObject. All lists are indexed from 1. Range check only
                if the compile-flag qRangeCheck is TRUE. The static-array equivalent of:
                object := objList.At(index); is: object := objArray[index]; }

                FUNCTION TList.GetEqualItemNo(item: TObject): ArrayIndex;
               { Return the index of the item in the list, or zero if the item is not in the list. }

                FUNCTION TList.GetSameItemNo(item: TObject): ArrayIndex;
                { Return the index of the IDENTITY item in the list, or zero if the item is not in the
                list. }

                FUNCTION TList.First: TObject;
                { Return the first element of the list. It is typical for the caller to coerce the
                result. Returns NIL if the size is <= 0. }

                FUNCTION TList.Last: TObject;
                { Return the last element of the list. It is typical for the caller to coerce the
                result. Returns NIL if the size is <= 0. }

                {Iterator Methods}

                FUNCTION TList.IterateTil(FUNCTION TestItem(item: TObject): Boolean;
                                          IterateForward: Boolean;
                                          VAR itsIndex: ArrayIndex): TObject;
                { The basic list iterator.    Call TestItem once for each element of the list, in order,
                until TestItem returns TRUE.
                  Return the element that satisfied the test.  If none satisfied the test, return NIL.
                  The actual parameter is typically a procedure whose argument is a descendant of TObject.
                  It is typical for the caller to coerce the result into that descendant of TObject.
                  If TestItem calls InsertLast, the newly added element will NOT be enumerated.
                  If TestItem calls AtPut, InsertBefore, InsertFirst, or DeleteAll, misbehavior will
                  ensue.  The static-array equivalent of:
                    object := objList.FirstThat(Func)
                  is:
                    object := NIL;
                    FOR index := 1 TO fSize DO IF Func(objArray[index]) THEN
                        BEGIN
                        object := objArray[index];
                        LEAVE;
                        END;
                }

                PROCEDURE TList.Each(PROCEDURE DoToItem(item: TObject));
                { Call DoToItem once for each element of the list, in order. The actual parameter is
                typically a procedure whose argument is a descendant of TObject.
                The static-array equivalent of:
                objList.Each(Proc) is:
                FOR index := 1 TO fSize DO
                    Proc(objArray[index]);
                }

                FUNCTION TList.FirstThat(FUNCTION TestItem(item: TObject): Boolean): TObject;
                { Call TestItem once for each element of the list, in order, until TestItem returns
                TRUE. Return the element that satisfied the test. If none satisfied the test,
                return NIL. The actual parameter is typically a procedure whose argument is a
                descendant of TObject. It is typical for the caller to coerce the result into that
                descendant of TObject. If TestItem calls InsertLast, the newly added element will
                NOT be enumerated. If TestItem calls AtPut, InsertBefore, InsertFirst, Delete, or
                DeleteAll, misbehavior will ensue. }

                FUNCTION TList.LastThat(FUNCTION TestItem(item: TObject): Boolean): TObject;
                { Call TestItem once for each element of the list, starting with the last item in the
                list and working toward the first item, until TestItem returns TRUE. Return the
                element that satisfied the test. If none satisfied the test, return NIL. The actual
                parameter is typically a procedure whose argument is a descendant of TObject. It is
                typical for the caller to coerce the result into that descendant of TObject. If
                TestItem calls InsertLast, the newly added element will NOT be enumerated. If
                TestItem calls AtPut, InsertBefore, InsertFirst, Delete, or DeleteAll, misbehavior
                will ensue. }

                {Item Insertion Methods}

                PROCEDURE TList.AtPut(index: ArrayIndex;
                                      newItem: TObject);
                { Replace the index'th item of the list. Does not free the old item. If you do this
                from within an Each the results will be unpredictable.}

                PROCEDURE TList.Insert(item: TObject);
                { Inserts the given item into the list in arrival sequence. }

                PROCEDURE TList.InsertBefore(index: ArrayIndex;
                                             item: TObject);
                { Insert a reference to an item before the indicated item. The index of the new
                element will be index. If index = 1 this inserts at the start of the list. If index
                = fSize + 1 this inserts at the end of the list. Signals Failure if unable to
                increase the size of the list.}

                PROCEDURE TList.InsertFirst(item: TObject);
                { Insert a reference to item at the front of the list. If the compile-flag qDebug is
                TRUE & SetEltType was called, verify item's type. Increase fSize by 1. The index of
                the new element will be 1. Signals Failure if unable to increase the size of the
                list.}

                PROCEDURE TList.InsertLast(item: TObject);
                { Insert a reference to item at the back of the list. If the compile-flag qDebug is
                TRUE & SetEltType was called, verify item's type. Increase fSize by 1. The index of
                the new element will be fSize. Signals Failure if unable to increase the size of
                the list.}

                {Item Deletion Methods}

                PROCEDURE TList.AtDelete(index: ArrayIndex);
                { Deletes via an index (rather than having to search for an item) }

                PROCEDURE TList.Delete(item: TObject);
                { Delete the first reference to item from the list, but do not free item. If item
                does not occur, do nothing. If item does occur, reduce fSize by 1.

                !!! NOTE: This name conflicts with the Pascal builtin: DELETE and we will be
                changing it's name, but changing the name at the _last minute_ isn't a good idea.
                If you need to use the builtin DELETE in a TList subclass, then you will have to
                create a wrapper procedure that forwards to it, for now. Sorry… the Management. }

                PROCEDURE TList.DeleteAll;
               { Delete every element from the list, but do not free any objects. Leave fSize at 0.}

                PROCEDURE TList.FreeAll;
                { Frees each element in the list.  Leave fSize at 0.}

                { Misc. functions }

                PROCEDURE TList.SortBy(FUNCTION
                                             CompareItems(item1, item2: TObject): CompareResult);
                { Sorts the list using the supplied CompareItems function.   Uses Shell sort (see
                Sedgewick, "Algorithms", pp. 97-9)  }

                PROCEDURE TList.Push(item: TObject);
                { LIFO stack push.(same as insertLast) }

                FUNCTION TList.Pop: TObject;
                { LIFO stack pop. }

                { Debugging Methods }

                PROCEDURE TList.SetEltType(toClass: MAName);
                { Call this once and pass the className of objects you intend to insert into the
                list. The TList insert methods will do a coercion to he type you specify, to ensure
                that the list contains only elements of the right type.}

                PROCEDURE TList.SetEltTypeID(toClassID: ObjClassID);
                { Call this once and pass the ObjClassID of objects you intend to insert into the
                list. The TList insert methods will do a coercion to the type you specify, to
                ensure that the list contains only elements of the right type.}

                PROCEDURE TList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                           fieldAddr: Ptr;
                                                           fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                fields. }

                PROCEDURE TList.DynamicFields(PROCEDURE
                                              DoToField(fieldName: Str255;
                                                        fieldAddr: Ptr;
                                                        fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                dynamic area. }
                PROCEDURE TList.GetInspectorName(VAR inspectorName: Str255); OVERRIDE;
                { Used by the Inspector to display the name of this class. }

                END;

            TSortedList         = OBJECT (TList)        { A sorted list of TObjects. Items are
                                                         sorted based on the results of Compare
                                                         which has to be overridden to provide a
                                                         comparison mechanism. }
                PROCEDURE TSortedList.ISortedList;
                { Initialize a sorted list }

                FUNCTION TSortedList.DoSearch(FUNCTION
                                              TestItem(anItem: TObject): CompareResult;
                                              VAR index: ArrayIndex): TObject;
                { Searches the sorted list until TestItem returns zero or there are no more
                  items to search.    A binary search is used. }

                FUNCTION TSortedList.GetEqualItemNo(item: TObject): ArrayIndex; OVERRIDE;
                { Return the index of any item that is considered to be equal to the parameter
                'item'. Two items are considered equal if comparing them with the Compare method
                returns zero. You may wish to use the constants kItemGreaterThanCriteria,
                kItemEqualCriteria, kItemLessThanCriteria. }

                PROCEDURE TSortedList.Insert(item: TObject); OVERRIDE;
                { Inserts the given item into the list in sorted order, using the Compare
                  method to determine the item's location relative to other items in the list. }

                FUNCTION TSortedList.Compare(item1, item2: TObject): CompareResult;
                { This method compares two items in the list. A negative result indicates that item1
                < item2. A result of zero indicates that item1 = item2. A positive result indicates
                that item1 > item2. You may wish to use the constants kItem1LessThanItem2,
                kItem1EqualItem2, kItem1GreaterThanItem2. By default just compare the ordinal value
                of the items. Subclasses that want to should override this method to do any other
                kind of comparison (comparing instance variables, for instance (get it?)). }

                FUNCTION TSortedList.Search(FUNCTION
                                            TestItem(anItem: TObject): CompareResult): TObject;
                { This method searches the list of an item that causes your supplied TestItem
                function to return true. This is useful for cases in which you are not comparing
                objects in the list with another object, as does Compare. For example, suppose each
                object has an fTitle field and the objects are inserted into the list in order of
                fTitle. You can use the search method to look for an object whose fTitle is equal
                to any string. A negative TestItem result indicates that your search criteria <
                anItem, a result of zero indicates the item has been found and Search returns that
                item. A positive TestItem result indicates that your search criteria > your anItem.
                }

                PROCEDURE TSortedList.Sort;
                { Sorts the list using TSortedList.Compare function and TList.SortBy.}

                PROCEDURE TSortedList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                           fieldAddr: Ptr;
                                                           fieldType: integer)); OVERRIDE;
                { Used by the Inspector and the Debugger to display the contents of this class's
                fields. }

                END;

        FUNCTION NewList: TList;
        { A convenience function. Create a TList, initialize it, and return a reference to it.
        Signals Failure if it cannot allocate the object.}

        FUNCTION NewSortedList: TSortedList;
        { A convenience function. Create a TSortedList, initialize it, and return a reference to it.
        Signals Failure if it cannot allocate the object.}

        FUNCTION NewAllocatedList(iSize: ArrayIndex): TList;
        { A convenience function. The same as NewList, but the initial allocation size can be set. }

        FUNCTION FreeListIfObject(list: TList): TList;
        { A convenience function. if list is non-nil then the same as list.FreeList.
        Returns NIL for convenient assignment back to the reference passed in. }

        {$ENDC}

        {$IFC NOT UsingIncludes}
END.
{$ENDC}